home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Skunkware 98
/
Skunkware 98.iso
/
src
/
interp
/
tclStruct1.2.tar.gz
/
tclStruct1.2.tar
/
tclStruct1.2
/
stAccess.c
< prev
next >
Wrap
C/C++ Source or Header
|
1995-10-17
|
12KB
|
399 lines
/*
* tclStruct package
* Support 'C' structures in Tcl
*
* Written by Matthew Costello
* (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "stInternal.h"
STRUCT_SCCSID("@(#)tclStruct:stAccess.c 1.3 95/10/17")
/*
* Struct_GetObject
* get the object from its name
*
* Side Effects:
* The object type is attached
*
*/
int
Struct_GetObject(interp,name,po)
Tcl_Interp *interp; /* Current interpreter. */
CONST char *name;
Struct_Object *po;
{
Struct_Object *object;
char *s,*y;
CONST char *err;
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s )\n", name ? name : "<null>" );
#endif
po->type = NULL;
/* Is this a bona-fide object? Note that this object
* could be an array reference. Normally the chopping
* up of a name is done internally (to Tcl) in
* tclVar.c:LookupVar(), so we need to duplicate that
* logic here.
*/
if ((s = strchr( name, '(' )) != NULL)
*s = '\0';
object = (Struct_Object *)STRUCT_GETOBJECT(interp,(char *)name);
if (s != NULL)
*s++ = '(';
if (object != NULL) {
Struct_CheckObject(object,"GetObject");
if (s != NULL) {
y = strchr( s, '\0' );
if (*--y != ')') {
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = NULL (badly formed!)\n",
name );
#endif
Tcl_AppendResult(interp,"badly formed object access",NULL);
return TCL_ERROR;
}
*y = '\0';
*po = *object;
Struct_AttachType(po->type);
err = Struct_AccessElement(interp,po,s);
*y = ')';
if (err != NULL) {
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = NULL (AE = %s!)\n",
name, err );
#endif
Tcl_SetResult(interp,(char *)err,NULL);
return TCL_ERROR;
}
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = %s\n",
name, Struct_ObjectName(object,1) );
#endif
return TCL_OK;
} else {
/* Set the object and attach its type. */
*po = *object;
Struct_AttachType(po->type);
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = %s\n",
name, Struct_ObjectName(object,1) );
#endif
return TCL_OK;
}
}
/* Do we have a specially formatted address pointer:
* type#address
* This is complicated by the fact that we cannot lookup
* a type name unless we have access to the hash table.
*/
if ( ((s = strchr( name, '#' )) != NULL) &&
((po->data = (void *)strtol( s+1, &y, 10 )) != NULL) &&
(*y == '\0') ) {
/* This could be it. Find the type hash table. */
ClientData cdata;
if ((cdata = Struct_GetClientData(interp)) == NULL) {
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = NULL (no hash table!)\n", name );
#endif
Tcl_AppendResult(interp,"cannot find tclStruct type table");
return TCL_ERROR;
}
/* Try to look up the type. */
*s = '\0';
po->type = Struct_LookupType(cdata,interp,name);
*s = '#';
if (po->type == NULL) {
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = NULL (unknown type!)\n", name );
#endif
return TCL_ERROR;
}
po->size = po->type->size;
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = %s\n",
name, Struct_ObjectName(po,0) );
#endif
return TCL_OK;
}
#ifdef DEBUG
if (struct_debug & (DBG_GETOBJECT))
printf("Struct_GetObject( %s ) = NULL (not an object!)\n", name );
#endif
Tcl_AppendResult(interp,"\"", name,"\" is not an object",NULL);
return TCL_ERROR;
}
/*
* get the object & check type
*
* Side Effects:
* does NOT attach the type
*/
int
Struct_GetObjectAndCheck(interp,name,type,object)
Tcl_Interp *interp; /* Current interpreter. */
CONST char *name;
CONST char *type;
Struct_Object *object;
{
if (Struct_GetObject(interp,name,object) == TCL_ERROR)
return TCL_ERROR;
if (object->type->name == NULL) {
Tcl_AppendResult(interp,"\"", name,"\" is"
" not of expected type ",type, (char *) NULL);
Struct_ReleaseType(object->type);
return TCL_ERROR;
} else if (strcmp(object->type->name,type) != 0) {
Tcl_AppendResult(interp,"\"", name,"\" is of type ",
object->type->name,
" and not of expected type ",type, (char *) NULL);
Struct_ReleaseType(object->type);
return TCL_ERROR;
}
Struct_ReleaseType(object->type);
return TCL_OK;
}
/*
* Figure out what part of the object is to be accessed, and
* its underlying type. Because this routine is generally
* called from a trace, it needs to return any error message
* directly to the caller.
*/
CONST char *
Struct_AccessElement(interp,object,name2)
Tcl_Interp *interp;
Struct_Object *object; /* I/O 'partial' object */
char *name2;
{
char *s;
Struct_StructElem *pelem;
char namebuf[256];
static char errbuf[256];
#ifdef DEBUG
if (struct_debug & (DBG_PARSEELEMENT))
printf("Struct_AccessElement( obj = %s, name2 = %s )\n",
Struct_ObjectName(object,0),
(name2 == NULL) ? "<null>" :
(*name2 == '\0') ? "<empty>" : name2 );
#ifdef TCL_MEM_DEBUG
Tcl_ValidateAllMemory(__FILE__,__LINE__);
#endif
#endif
if (name2 == NULL || *name2 == '\0') {
return NULL; /* OKAY */
}
if (strchr(name2,'.') != NULL || *name2 == '_') {
strcpy( namebuf, name2 );
name2 = namebuf;
}
#ifdef lint
s = NULL; /* Damm those lint bugs anyway! */
#endif
for ( ; name2 != NULL ; name2 = s ) {
if ((s = strchr( name2, '.' )) != NULL) {
*s++ = '\0';
}
#ifdef DEBUG
if (struct_debug & (DBG_PARSEELEMENT))
printf("Struct_AccessElement: obj = %s, elem = %s\n",
Struct_ObjectName(object,0),
name2 ? name2 : "<null>" );
#endif
/* Element names beginning and ending with '_' are
* reserved for type overrides.
*/
if (name2[0] == '_' && name2[strlen(name2)-1] == '_') {
/* We need to find out where the typedef hash table is. */
ClientData cdata;
if ((cdata = Struct_GetClientData(interp)) == NULL)
return "No access to type table";
/* Convert to just the type name. */
name2[strlen(name2)-1] = '\0';
/* Because we don't want the "_addr_" to lose the underlying
* type, we handle _addr_ specially by crafting a pointer
* with the Struct_TraceAddr() attached.
*/
if (strcmp("addr", name2+1 ) == 0) {
Struct_TypeDef *oldtype = object->type;
object->type = Struct_NewType(cdata,interp,NULL,0,
STRUCT_FLAG_IS_ADDR,Struct_TraceAddr);
object->type->u.a.array_elem = oldtype;
continue;
}
/* Look it up. */
Struct_ReleaseType(object->type);
if ((object->type = Struct_LookupType(cdata,interp,name2+1)) == NULL) {
(void) strncpy( errbuf, interp->result, sizeof(errbuf)-1 );
return errbuf;
}
/* Verify that the sizes are compatible. This means that the
* sizes are either identical, or the new size is a multiple
* of the original.
*/
if (object->size == object->type->size) {
/*EMPTY*/;
} else if (object->type->size == 0) {
/* Zero-length object */
return "object is of zero length";
} else if ( ((object->size % object->type->size) == 0) &&
(object->type->flags & STRUCT_FLAG_TRACE_ARRAY) ) {
/* Multiple. Make it an array. */
Struct_TypeDef *oldtype = object->type;
object->type = Struct_DefArray( cdata, interp,
object->type,
(int)(object->size / object->type->size) );
Struct_ReleaseType(oldtype);
} else if (object->size > object->type->size) {
/* Shorter than before. Use the shorter size. */
object->size = object->type->size;
} else {
sprintf(errbuf,"type \"%s\" does not have compatible size", name2+1 );
return errbuf;
}
continue;
}
/* The component of the name may either be a numeric
* offset into an array, or a named element of a
* structure.
*/
if (isdigit(name2[0]) || name2[0] == '-') {
int num;
int num2 = -1;
char *after;
Struct_TypeDef *oldtype;
if (!(object->type->flags & (STRUCT_FLAG_IS_ARRAY|STRUCT_FLAG_IS_POINTER))) {
sprintf(errbuf,"\"%s\" is not an array or pointer",
object->type->name );
return errbuf;
}
num = strtol( name2, &after, 10 );
if (*after == '-') {
/* A range. */
num2 = strtol( after+1, &after, 10 );
if (num2 != 0 && num2 <= num)
return "array indices are reversed";
}
if (*after != '\0') {
sprintf(errbuf,"invalid array index \"%s\"", name2 );
return errbuf;
}
if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
int nelem = object->size / object->type->u.a.array_elem->size;
if ( (num < 0) ||
((num >= nelem) &&
(object->type->flags & STRUCT_FLAG_STRICT)) )
return "array index is out of range";
if ( (num2 > 0) && (num2 >= nelem) &&
(object->type->flags & STRUCT_FLAG_STRICT) )
return "array index is out of range";
} else if (object->type->flags & STRUCT_FLAG_STRICT) {
if (num != 0)
return "using non-zero index on pointer";
if (num2 > 0)
return "using non-zero index on pointer";
}
oldtype = object->type;
if (object->type->flags & (STRUCT_FLAG_IS_POINTER)) {
/* Convert Pointer to array. Do it so as to avoid
* a bus error for misalignment. */
void *v;
memcpy( (char *)&v, object->data, sizeof(v) );
if (v == NULL)
return "trying to dereference a NULL pointer";
object->data = v;
}
if (num2 >= 0) {
ClientData cdata;
if ((cdata = Struct_GetClientData(interp)) == NULL)
return "No access to type table";
/* Create array */
if (num2 == 0)
num2 = object->size / object->type->u.a.array_elem->size;
object->type = Struct_DefArray( cdata, interp,
object->type->u.a.array_elem,
num2 - num );
/* Struct_AttachType(object->type); attached by DefArray */
Struct_ReleaseType(oldtype);
object->size = object->type->size;
object->data = ((char *)object->data) + num * object->type->u.a.array_elem->size;
} else {
/* Point it at single object */
object->type = object->type->u.a.array_elem;
Struct_AttachType(object->type);
Struct_ReleaseType(oldtype);
object->size = object->type->size;
object->data = ((char *)object->data) + num * object->size;
}
continue;
}
/* At this point we have either a named element, or an empty
* name. In the interest of expediency we will automatically
* do a single level of pointer dereferencing.
*/
if (object->type->flags & (STRUCT_FLAG_IS_POINTER)) {
Struct_TypeDef *oldtype;
void *v;
memcpy( (char *)&v, object->data, sizeof(v) );
if (v == NULL)
return "trying to dereference a NULL pointer";
oldtype = object->type;
object->type = object->type->u.a.array_elem;
Struct_AttachType(object->type);
Struct_ReleaseType(oldtype);
object->data = v;
object->size = object->type->size;
if (name2[0] == '\0')
continue; /* Explicit dereference */
}
/* This must be a named element of a structure.
*/
if (!(object->type->flags & STRUCT_FLAG_IS_STRUCT)) {
sprintf(errbuf, "\"%s\" is not a struct", object->type->name );
return errbuf;
}
/* Look up the name. */
for ( pelem = object->type->u.s.struct_def;
pelem->name == NULL || strcmp(pelem->name,name2) != 0;
pelem++ ) {
if (pelem->type == NULL) {
sprintf(errbuf, "\"%s\" is not a member", name2 );
return errbuf;
}
}
object->data = (char *)object->data + pelem->offset;
Struct_AttachType(pelem->type);
Struct_ReleaseType(object->type);
object->type = pelem->type;
object->size = object->type->size;
}
#ifdef DEBUG
if (struct_debug & (DBG_PARSEELEMENT))
printf("Struct_AccessElement() = %s\n", Struct_ObjectName(object,0) );
#endif
return NULL; /*OKAY*/
}